Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/vbpong1a/blockcod.bas

BASIC Source File | 1999-08-15 | 5.1 KB | 167 lines

Attribute VB_Name = "BlockCode"
Public Blcks1(3) As Block
Public Blcks2(3) As Block
Public rcts1(3) As RECT
Public rcts2(3) As RECT

Public Sub InitBlocks()
    For i = 0 To UBound(Blcks1)
        Set Blcks1(i) = New Block
        Blcks1(i).Create 305, 123 + (i * 31), 2, 1
    Next i
    For i = 0 To UBound(Blcks2)
        Set Blcks2(i) = New Block
        Blcks2(i).Create 321, 123 + (i * 31), 2, 2
    Next i

    For i = 0 To UBound(Blcks1)
        With rcts1(i)
            .Top = Blcks1(i).y
            .Left = Blcks1(i).x
            .Bottom = Blcks1(i).y + 30
            .Right = Blcks1(i).x + 15
        End With
    Next i
    For i = 0 To UBound(Blcks2)
        With rcts2(i)
            .Top = Blcks2(i).y
            .Left = Blcks2(i).x
            .Bottom = Blcks2(i).y + 30
            .Right = Blcks2(i).x + 15
        End With
    Next i
End Sub

Public Sub BlitBlocks()
    For i = 0 To UBound(Blcks1)
        If Blcks1(i).bBActive Then Blcks1(i).Blit myScreen.m_lpDDSBack
    Next i
    For i = 0 To UBound(Blcks2)
        If Blcks2(i).bBActive Then Blcks2(i).Blit myScreen.m_lpDDSBack
    Next i
End Sub

Public Sub BlockCollisions()
    Dim rball1 As RECT, rball2 As RECT, dr As RECT

    With rball1
        .Top = myBall1.y
        .Left = myBall1.x
        .Bottom = myBall1.y + 9
        .Right = myBall1.x + 9
    End With

    With rball2
        .Top = myBall2.y
        .Left = myBall2.x
        .Bottom = myBall2.y + 9
        .Right = myBall2.x + 9
    End With

    For i = 0 To UBound(Blcks1)
        If Blcks1(i).bBActive Then
            If IntersectRect(dr, rball1, rcts1(i)) Then
                If dr.Right - dr.Left > dr.Bottom - dr.Top Then
                    myBall1.yvel = -myBall1.yvel
                Else
                    myBall1.xvel = -myBall1.xvel
                End If
                Blcks1(i).strength = Blcks1(i).strength - 1
                If Blcks1(i).strength < 0 Then Blcks1(i).bBActive = False
                DSoundCode.PlayBounce2
            End If

            If IntersectRect(dr, rball2, rcts1(i)) Then
                If dr.Right - dr.Left > dr.Bottom - dr.Top Then
                    myBall2.yvel = -myBall2.yvel
                Else
                    myBall2.xvel = -myBall2.xvel
                End If
                Blcks1(i).strength = Blcks1(i).strength - 1
                If Blcks1(i).strength < 0 Then Blcks1(i).bBActive = False
                DSoundCode.PlayBounce2
            End If
        End If
    Next i

    For i = 0 To UBound(Blcks2)
        If Blcks2(i).bBActive Then
            If IntersectRect(dr, rball1, rcts2(i)) Then
                If dr.Top - rcts2(i).Top > 0 Then
                    myBall1.yvel = -myBall1.yvel
                End If
                If dr.Bottom - rcts2(i).Bottom > 0 Then
                    myBall1.yvel = -myBall1.yvel
                End If
                If dr.Left - rcts2(i).Left > 0 Then
                    myBall1.xvel = -myBall1.xvel
                End If
                If dr.Right - rcts2(i).Right > 0 Then
                    myBall1.xvel = -myBall1.xvel
                End If
                Blcks2(i).strength = Blcks2(i).strength - 1
                If Blcks2(i).strength < 0 Then Blcks2(i).bBActive = False
                DSoundCode.PlayBounce2
            End If

            If IntersectRect(dr, rball2, rcts2(i)) Then
                If dr.Top - rcts2(i).Top > 0 Then
                    myBall2.yvel = -myBall2.yvel
                End If
                If dr.Bottom - rcts2(i).Bottom > 0 Then
                    myBall2.yvel = -myBall2.yvel
                End If
                If dr.Left - rcts2(i).Left > 0 Then
                    myBall2.xvel = -myBall2.xvel
                End If
                If dr.Right - rcts2(i).Right > 0 Then
                    myBall2.xvel = -myBall2.xvel
                End If
                Blcks2(i).strength = Blcks2(i).strength - 1
                If Blcks2(i).strength < 0 Then Blcks2(i).bBActive = False
                DSoundCode.PlayBounce2
            End If
        End If
    Next i
End Sub

Public Function RedBlocksRemaining() As Integer
    Dim n As Integer

    For i = 0 To UBound(Blcks2)
        If Blcks2(i).bBActive Then n = n + 1
    Next i

    RedBlocksRemaining = n
End Function

Public Function GreenBlocksRemaining() As Integer
    Dim n As Integer

    For i = 0 To UBound(Blcks1)
        If Blcks1(i).bBActive Then n = n + 1
    Next i

    GreenBlocksRemaining = n
End Function

Public Sub RestoreGreenBlock()
    For i = 0 To UBound(Blcks1)
        If Blcks1(i).bBActive = False Then
            Blcks1(i).bBActive = True
            Blcks1(i).strength = 2
            Exit For
        End If
    Next i
End Sub

Public Sub RestoreRedBlock()
    For i = 0 To UBound(Blcks2)
        If Blcks2(i).bBActive = False Then
            Blcks2(i).bBActive = True
            Blcks2(i).strength = 2
            Exit For
        End If
    Next i
End Sub